'*****************************************************************

'**     Example to illustrate the speed of transferring data    **

'**     over the bus from the 2001 internal data buffer after   **

'**     it has been collected. The program allows the user to   **

'**     select various functions and integration rates.         **

'**                                                             **

'**     The program uses the KPC-488.2AT IEEE-488 Interface.    **

'**                                                             **

'**     Author: Jonathan L. Tucker                              **

'**     Date:   June 23, 1994                                   **

'**     Copyright (c) 1994, Keithley Instruments, Inc.          **

'*****************************************************************



'$INCLUDE: 'ieeeqb.bi'

DIM Readings!(1 TO 5000), dummy!(1 TO 1)

 

        CLS

        CALL initialize(21, 0)                  ' PC controller at 21



        PRINT "Select function"

        PRINT "1) DCV"

        PRINT "2) ACV"

        PRINT "3) DCI"

        PRINT "4) ACI"

        PRINT "5) 2-wire Ohms"

        PRINT "6) 4-wire Ohms"

        INPUT func



        PRINT

        INPUT "Enter NPLC (10 to .01) ==>"; nplc$



        cmd$ = "*RST"                           ' Reset 2001

        GOSUB sendcmd

               

        cmd$ = ":Form:Data Sreal;Elem Read;Bord Swap"

        GOSUB sendcmd



        SELECT CASE func

          CASE 1

               func$ = ":sens:volt:dc"

               cmd$ = ":Sense:Func 'Volt:DC'"

               GOSUB sendcmd

          CASE 2

               func$ = ":sens:volt:ac"

               cmd$ = ":Sense:Func 'Volt:AC'"

               GOSUB sendcmd

          CASE 3

               func$ = ":sens:curr:DC"

               cmd$ = ":Sense:Func 'Curr:DC'"

               GOSUB sendcmd

          CASE 4

               func$ = ":sens:curr:ac"

               cmd$ = ":Sense:Func 'Curr:AC'"

               GOSUB sendcmd

          CASE 5

               func$ = ":sens:Res"

               cmd$ = ":Sense:Func 'Res'"

               GOSUB sendcmd

          CASE 6

               func$ = ":sens:Fres"

               cmd$ = ":Sense:Func 'Fres'"

               GOSUB sendcmd

        END SELECT





        cmd$ = ":Init:Cont Off;:Abor"           ' Stop Trigger Model

        GOSUB sendcmd



        cmd$ = ":Syst:Azer:Stat Off"            ' Turn Autozero off

        GOSUB sendcmd



        cmd$ = ":Syst:Lsyn:Stat Off"            ' Turn Line Sync off

        GOSUB sendcmd

       

        cmd$ = ":Calc:Stat Off"                 ' Turn Math off

        GOSUB sendcmd

      

        cmd$ = LTRIM$(func$) + ":Range:Auto On"

        GOSUB sendcmd



        cmd$ = LTRIM$(func$) + ":NPLC " + LTRIM$(nplc$)

        GOSUB sendcmd





        cmd$ = LTRIM$(func$) + ":Dig 4"

        GOSUB sendcmd



        cmd$ = LTRIM$(func$) + ":Aver:Stat Off"

        GOSUB sendcmd



        cmd$ = LTRIM$(func$) + ":Aver:Auto Off"

        GOSUB sendcmd



        cmd$ = LTRIM$(func$) + ":Ref:Stat Off"

        GOSUB sendcmd



        cmd$ = "*CLS;:Stat:meas:PTR 512;NTR 0;Enable 512"

        GOSUB sendcmd



        cmd$ = "*SRE 1"

        GOSUB sendcmd



        cmd$ = ":Trace:Clear"

        GOSUB sendcmd



        cmd$ = ":Trace:Feed Sens"

        GOSUB sendcmd



        cmd$ = ":Trace:Egroup Compact"

        GOSUB sendcmd



        cmd$ = ":Trace:Points 5000"

        GOSUB sendcmd



        cmd$ = ":Trace:Feed:Control Next"

        GOSUB sendcmd



        cmd$ = ":Disp:Enab off"

        GOSUB sendcmd



        cmd$ = ":Init:Cont On"                  ' Start Trigger Model

        GOSUB sendcmd



        t1 = TIMER



        PRINT "Test in Progress....."

       

        WHILE (NOT (srq%)): WEND

       

        cmd$ = ":Trace:Data?"                   ' Get Data

        GOSUB sendcmd





'   Setup CEC for LISTEN & 2001 for TALK

      

        CALL transmit("UNT UNL MLA TALK 16", status%)



'   Read 2 bytes (#0)

      

        r$ = SPACE$(2)

        CALL receive(r$, l%, status%)

        NumDataPoints% = 5000



'   Get Data in 4 blocks since CEC can only handle up to 64kB

'   per data transfer.

      

        NumBytes% = NumDataPoints% * 4

        CALL rarray(Readings!(1), NumBytes%, l%, status%)

      

'   get Terminator Character(s)



        CALL settimeout(100)

        CALL rarray(dummy!(1), 1, l%, status%)

        CALL settimeout(10000)

        CALL transmit("UNT UNL", status%)

                                        ' UNTalk and UNListen all devices



        t2 = TIMER



        PRINT "Starting Time = "; t1

        PRINT "Ending Time = "; t2

        PRINT "Acquisition Time = "; t2 - t1

        PRINT "Readings Per Second = "; 5000 / (t2 - t1)



        cmd$ = ":Disp:Enab On;*RST"

        GOSUB sendcmd



        cmd$ = "Stat:Meas:Event?"

        CALL send(16, cmd$, status%)

        stat$ = SPACE$(30)

        CALL enter(stat$, l%, 16, status%)



END





sendcmd:

        PRINT cmd$

        CALL send(16, cmd$, status%)

        IF status% <> 0 THEN STOP               ' test for errors

        RETURN